procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;


procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please make a rectangular selection.');
    exit;
  end;
end;


procedure CropScaleNN;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Nearest; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


procedure CropScaleBL;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Bilinear; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


procedure CropScaleBC;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Bicubic; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


macro 'crop and scale - NN';
begin CropScaleNN; end;

macro 'crop and scale - bilinear';
begin CropScaleBL; end;

macro 'crop and scale - bicubic';
begin CropScaleBC; end;


macro 'flip stack horizontal';
var
  i,invno,width,height,nSlice:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
	  FlipHorizontal;
  end;
end;


macro 'add slice     [A]';
begin
Addslice;
end;

macro 'delete slice [D]';
begin
Deleteslice;
end;


macro '(-' begin end;



macro 'import raw image [0]';
var
w,h:   integer;
begin
w:= GetNumber('width: ',1200);
h:= GetNumber('height: ',1000);
SetImport('Custom');
SetCustom(w,h,0);
Import('image');
end;


macro 'make ROI there     [X]';
var
x,y,left,top,width,height:integer;
begin
GetMouse(x,y);
GetPicSize(width,height);
 left:=GetNumber('left:',x);
 top:=GetNumber('top:',y);
 width:=GetNumber('width:',1200);
 height:=GetNumber('height:',1000);
MakeRoi(left,top,width,height);
end;

macro '(-' begin end;



macro 'remove 0 and 255 [R]';
var
  i:integer;
begin
  UpdateLUT;
ApplyLUT;
end;



macro 'invert 0-180         [-]';
var
  i:integer;
begin
  for i:=1 to 254 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  ApplyLUT;
AddConstant(-74);
end;


{============================================= c - axes  ===================}

macro '(-' begin end;

macro 'c-axes AZI INC from Euler   [C]';
var
  x,y,i,j,w,h,n,m: integer;
  fi1,psi,azi,inc: integer;

begin

CheckforStack;

SelectSlice(nSlices);
n:=nSlices+1;
AddSlice;
m:=nSlices+1;
AddSlice;

PutMessage('This macro calculates c-axes from Euler angles (stored in slice 1,2,3), and stores azi/inc of c-axes in new slices ',n,' and ',m'.');

getPicsize(w,h);

   for i:=0 to w-1 do begin
   for j:=0 to h-1 do begin

   x:=i;
   y:=j;

{-----------26.11.2008 alles neu ----------------}

   ChooseSlice(1);
			fi1:=360*(GetPixel(x,y))/255;

   ChooseSlice(2);
			psi:=180*(GetPixel(x,y))/255;


{-----------26.11.2008 fi1 und inc 0-180 ----------------}

			 if fi1>180 then  psi:=180-psi;
			 if fi1>180 then  fi1:=fi1-180;

{-----------26.11.2008 azi / inc ----------------}

   azi:= 90+fi1;
			if azi> 180 then psi:=180-psi;
			if azi> 180 then azi:=azi-180;
   inc:=psi;
{-----------26.11.2008 in file einschreiben ----------------}

ChooseSlice(n);                 {c-axis azi}
Putpixel(x,y,azi);

ChooseSlice(m);                 {c-achse inc}
Putpixel(x,y,inc);

end;
end;

ChooseSlice(n);                 {c-axis azi}
  for i:=0 to 255 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  ApplyLUT;
 AddConstant(-74);

end;


{============================================= a1 - axes  ===================}



macro 'a1-axes AZI INC from Euler [1]';
var
  x,y,i,ii,jj,w,h,n,m: integer;
  fi1,psi,fi2,xx,yy,zz,xn,yn,zn,rr: real;
  factor,pi,rad,cosrho,sinrho,alfa: real;
  azi,inc:integer;

begin

CheckforStack;
   
SelectSlice(nSlices);
n:=nSlices+1;
AddSlice;
m:=nSlices+1;
AddSlice;

   factor:= 0.01745329252;   { pi/180 }
   pi:= 3.14159265358979;
   rad:= 57.29577951308;

PutMessage('This macro calculates a3-axes from Euler angles (stored in slice 1,2,3), and stores azi/inc of a3-axes in slices ',n,' and ',m'.');
 

getPicsize(w,h);

   for ii:=0 to w-1 do begin
   for jj:=0 to h-1 do begin

   x:=ii;
   y:=jj;

{----------- 27.11.2008 ----------------}

   ChooseSlice(1);
			fi1:=360.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(2);
			psi:=180.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(3);
			fi2:=360.*(GetPixel(x,y)+1)/255.;

{----------- 27.11.2008 rotate <a> to fi2 CLW looking down z ---------------}

   xx:= cos(factor*fi2);
   yy:= -sin(factor*fi2);                    { pos?}
   zz:= 0.000;

{----------- 27.11.2008 rotate <a> (at fi2) about psi CLW looking down y  -----}

   cosrho:=cos(factor*psi);
   sinrho:=-sin(factor*psi);                 { pos?}
   xn:=cosrho*xx - sinrho*zz;
   zn:=sinrho*xx + cosrho*zz;                    
   xx:=xn;
   zz:=zn;

{----------- 27.11.2008 rotate <a> (at fi2 and psi) about fi2 CLW looking down z --------}

   cosrho:=cos(factor*fi1);
   sinrho:=-sin(factor*fi1);                 { pos?}
   xn:=cosrho*xx - sinrho*yy;
   yn:=sinrho*xx + cosrho*yy;
   xx:=xn;
   yy:=yn;

{----------- 27.11.2008 find azimuth and dip of point (xx,yy,zz) ----------------}

   if xx<0.00 then yy:=-yy;
   if xx<0.00 then zz:=-zz;
   if xx<0.00 then xx:=-xx;

   rr  := sqrt(xx*xx + yy*yy);

   inc:=90.00;
   if zz<>0 then inc:= rad*arctan(rr/zz);
   if inc<0 then inc:= 180+inc;

   azi:= 90.00;
   if (yy<>0.000) then azi:= rad*arctan(xx/yy);
   if azi<0 then azi:=azi+180;


Chooseslice(n);                 {a-axis azi}
Putpixel(x,y,azi);

Chooseslice(m);                 {a-achse inc}
Putpixel(x,y,inc);

end;
end;

ChooseSlice(n);                 {a3-axis azi}
  for i:=1 to 254 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  ApplyLUT;
AddConstant(-74);

end;


{============================================= a2 - axes  ===================}



macro 'a2-axes AZI INC from Euler [2]';
var
  x,y,i,ii,jj,w,h,n,m: integer;
  fi1,psi,fi2,xx,yy,zz,xn,yn,zn,rr: real;
  factor,pi,rad,cosrho,sinrho,alfa: real;
  azi,inc:integer;

begin

CheckforStack;
   
SelectSlice(nSlices);
n:=nSlices+1;
AddSlice;
m:=nSlices+1;
AddSlice;

   factor:= 0.01745329252;   { pi/180 }
   pi:= 3.14159265358979;
   rad:= 57.29577951308;

PutMessage('This macro calculates a3-axes from Euler angles (stored in slice 1,2,3), and stores azi/inc of a3-axes in slices ',n,' and ',m'.');
 

getPicsize(w,h);

   for ii:=0 to w-1 do begin
   for jj:=0 to h-1 do begin

   x:=ii;
   y:=jj;

{----------- 27.11.2008 ----------------}

   ChooseSlice(1);
			fi1:=360.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(2);
			psi:=180.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(3);
			fi2:=360.*(GetPixel(x,y)+1)/255.;

{----------- 27.11.2008 fi2 of <a2> ---------------}

   fi2:=fi2+120.;
   if fi2>360 then fi2:=fi2-360;

{----------- 27.11.2008 rotate <a> to fi2 CLW looking down z ---------------}

   xx:= cos(factor*fi2);
   yy:= -sin(factor*fi2);                    { pos?}
   zz:= 0.000;

{----------- 27.11.2008 rotate <a> (at fi2) about psi CLW looking down y  -----}

   cosrho:=cos(factor*psi);
   sinrho:=-sin(factor*psi);                 { pos?}
   xn:=cosrho*xx - sinrho*zz;
   zn:=sinrho*xx + cosrho*zz;                    
   xx:=xn;
   zz:=zn;

{----------- 27.11.2008 rotate <a> (at fi2 and psi) about fi2 CLW looking down z --------}

   cosrho:=cos(factor*fi1);
   sinrho:=-sin(factor*fi1);                 { pos?}
   xn:=cosrho*xx - sinrho*yy;
   yn:=sinrho*xx + cosrho*yy;
   xx:=xn;
   yy:=yn;

{----------- 27.11.2008 find azimuth and dip of point (xx,yy,zz) ----------------}

   if xx<0.00 then yy:=-yy;
   if xx<0.00 then zz:=-zz;
   if xx<0.00 then xx:=-xx;

   rr  := sqrt(xx*xx + yy*yy);

   inc:=90.00;
   if zz<>0 then inc:= rad*arctan(rr/zz);
   if inc<0 then inc:= 180+inc;

   azi:= 90.00;
   if (yy<>0.000) then azi:= rad*arctan(xx/yy);
   if azi<0 then azi:=azi+180;


Chooseslice(n);                 {a-axis azi}
Putpixel(x,y,azi);

Chooseslice(m);                 {a-achse inc}
Putpixel(x,y,inc);

end;
end;

ChooseSlice(n);                 {a3-axis azi}
  for i:=1 to 254 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  ApplyLUT;
AddConstant(-74);

end;


{============================================= a3 - axes  ===================}


macro 'a3-axes AZI INC from Euler [3]';
var
  x,y,i,ii,jj,w,h,n,m: integer;
  fi1,psi,fi2,xx,yy,zz,xn,yn,zn,rr: real;
  factor,pi,rad,cosrho,sinrho,alfa: real;
  azi,inc:integer;

begin

CheckforStack;
   
SelectSlice(nSlices);
n:=nSlices+1;
AddSlice;
m:=nSlices+1;
AddSlice;

   factor:= 0.01745329252;   { pi/180 }
   pi:= 3.14159265358979;
   rad:= 57.29577951308;

PutMessage('This macro calculates a3-axes from Euler angles (stored in slice 1,2,3), and stores azi/inc of a3-axes in slices ',n,' and ',m'.');
 

getPicsize(w,h);

   for ii:=0 to w-1 do begin
   for jj:=0 to h-1 do begin

   x:=ii;
   y:=jj;

{----------- 27.11.2008 ----------------}

   ChooseSlice(1);
			fi1:=360.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(2);
			psi:=180.*(GetPixel(x,y)+1)/255.;

   ChooseSlice(3);
			fi2:=360.*(GetPixel(x,y)+1)/255.;

{----------- 27.11.2008 fi2 of <a3> ---------------}

   fi2:=fi2+240.;
   if fi2>360 then fi2:=fi2-360;

{----------- 27.11.2008 rotate <a> to fi2 CLW looking down z ---------------}

   xx:= cos(factor*fi2);
   yy:= -sin(factor*fi2);                    { pos?}
   zz:= 0.000;

{----------- 27.11.2008 rotate <a> (at fi2) about psi CLW looking down y  -----}

   cosrho:=cos(factor*psi);
   sinrho:=-sin(factor*psi);                 { pos?}
   xn:=cosrho*xx - sinrho*zz;
   zn:=sinrho*xx + cosrho*zz;                    
   xx:=xn;
   zz:=zn;

{----------- 27.11.2008 rotate <a> (at fi2 and psi) about fi2 CLW looking down z --------}

   cosrho:=cos(factor*fi1);
   sinrho:=-sin(factor*fi1);                 { pos?}
   xn:=cosrho*xx - sinrho*yy;
   yn:=sinrho*xx + cosrho*yy;
   xx:=xn;
   yy:=yn;

{----------- 27.11.2008 find azimuth and dip of point (xx,yy,zz) ----------------}

   if xx<0.00 then yy:=-yy;
   if xx<0.00 then zz:=-zz;
   if xx<0.00 then xx:=-xx;

   rr  := sqrt(xx*xx + yy*yy);

   inc:=90.00;
   if zz<>0 then inc:= rad*arctan(rr/zz);
   if inc<0 then inc:= 180+inc;

   azi:= 90.00;
   if (yy<>0.000) then azi:= rad*arctan(xx/yy);
   if azi<0 then azi:=azi+180;


Chooseslice(n);                 {a-axis azi}
Putpixel(x,y,azi);

Chooseslice(m);                 {a-achse inc}
Putpixel(x,y,inc);

end;
end;

ChooseSlice(n);                 {a3-axis azi}
  for i:=1 to 254 do begin
    RedLUT[i]:=255-RedLut[i];
    GreenLUT[i]:=255-GreenLut[i];
    BlueLUT[i]:=255-BlueLut[i];
  end;
  ApplyLUT;
AddConstant(-74);

end;



{==============================================================}


macro '(-' begin end;


macro 'c-axes AZI and INC from Euler by LUT [L]';
var
  n,m,i,j:integer;
BEGIN

CheckforStack;

PutMessage('This stack has ',nSlices, ' slices');
   
SelectSlice(nSlices);
n:=nSlices+1;
AddSlice;
m:=nSlices+1;
AddSlice;

PutMessage('This macro calculates c-axes from Euler angles (stored in slice 1,2,3) using LUT operations, and stores azi/inc of c-axes in slices ',n,' and ',m'.');

Chooseslice(1);
SelectAll;
Copy;
Chooseslice(n);
Paste;
DoCopy;
  for i:=0 to 63 DO begin
    j:=i+64;
    RedLUT[i]:=255-j;
    GreenLUT[i]:=255-j;
    BlueLUT[i]:=255-j;
  end;
  for i:=64 to 127 DO begin
    j:=i-64;
    RedLUT[i]:=255-j;
    GreenLUT[i]:=255-j;
    BlueLUT[i]:=255-j;
  end;
   for i:=128 to 191 DO begin
    j:=i-64;
    RedLUT[i]:=255-j;
    GreenLUT[i]:=255-j;
    BlueLUT[i]:=255-j;
  end;
  for i:=192 to 255 DO begin
    j:=i-192;
    RedLUT[i]:=255-j;
    GreenLUT[i]:=255-j;
    BlueLUT[i]:=255-j;
  end;
  UpdateLUT;
ApplyLUT;
MultiplybyConstant(1.41);


AddSlice;
n:=n+1;
m:=m+1;

Chooseslice(1);
SelectAll;
Copy;
Chooseslice(n);
Paste;
DoCopy;
SetDensitySlice(64,192);
ApplyLut;

Chooseslice(m);
Paste;
DoCopy;
SetDensitySlice(64,192);
ApplyLut;
InvertLUT;
ApplyLUT;

Chooseslice(2);
SelectAll;
Copy;
Chooseslice(n);
Paste;
DoAND;

MultiplybyConstant(0.705);
Chooseslice(m);
Paste;
DoAND;
MultiplybyConstant(0.705);

SelectAll;
Copy;
Chooseslice(n);
Paste;
DoOr;

SelectSlice(m);
DeleteSlice;

end;


macro '(-' begin end;



MACRO 'export RAW azi and inc      [E]';
var
zero,i,j,w,h:   integer;
fname  :    string;

   BEGIN
 
   GetPicSize(w,h);
   fname:=GetString('file and axis name ?',WindowTitle);

 zero:=GetNumber(concat('azi (',fname,'.azi) is on slice no.?'),4);

    SelectSlice(zero);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.azi');
    Paste; DoCopy;
        Export;
            Dispose;

    SelectSlice(zero+1);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.inc');
    Paste; DoCopy;
        Export;
            Dispose;




end;



MACRO 'export all RAW azi and inc [F]';
var
zero,i,j,w,h:   integer;
fname  :    string;

   BEGIN
 
   GetPicSize(w,h);
   fname:=GetString('file name ?',WindowTitle);

 zero:=GetNumber(concat('first azi (',fname,'.azi) is on slice no.?'),4);

    SelectSlice(zero);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'cL.azi');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+1);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'cL.inc');
    Paste;
        Export;
            Dispose;


    SelectSlice(zero+2);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'c.azi');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+3);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'c.inc');
    Paste;
        Export;
            Dispose;


    SelectSlice(zero+4);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a1.azi');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+5);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a1.inc');
    Paste;
        Export;
            Dispose;


    SelectSlice(zero+6);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a2.azi');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+7);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a2.inc');
    Paste;
        Export;
            Dispose;


    SelectSlice(zero+8);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a3.azi');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+9);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'a3.inc');
    Paste;
        Export;
            Dispose;

end;
